packages<-c("adehabitatHR","data.table","ggfortify","grid","move","moveVis","OpenStreetMap","pbapply","plotly","rgdal","sp","tidyverse","viridis")
sapply(packages, require, character.only=T)
adehabitatHR data.table ggfortify grid move moveVis OpenStreetMap pbapply
TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
plotly rgdal sp tidyverse viridis
TRUE TRUE TRUE TRUE TRUE
American Mink Dataset
This dataset looked at the American Mink home ranges in Illinois where there habitat has been highly altered.They studied 20 individuals for 6 years (2007-2012) and recorded present. The years in which they studied the minks they had record-breaking drought and flood conditions. They used mark-recapture methods and telemetry to track the individuals.
For this assignment I looked at individuals 1 , 10 and 11
Individual 1: 117 locations
Individual 10: 125 locations
Individual 11: 184 locations
mink <- read_csv("mink.csv")
qaqc_plot <- ggplot() + geom_point(data=mink,
aes(utm_easting,utm_northing,
color=individual_local_identifier)) +
labs(x="Easting", y="Northing") +
guides(color=guide_legend("Identifier"))
ggplotly(qaqc_plot)
lapply(split(mink, mink$individual_local_identifier),
function(x)write.csv(x, file = paste(x$individual_local_identifier[1],".csv"), row.names = FALSE))
$`1`
NULL
$`10`
NULL
$`11`
NULL
files <- c("1 .csv","10 .csv", "11 .csv")
utm_points <- cbind(mink$utm_easting, mink$utm_northing)
utm_locations <- SpatialPoints(utm_points,
proj4string=CRS("+proj=utm +zone=16 +datum=WGS84"))
proj_lat.lon <- as.data.frame(spTransform(
utm_locations, CRS("+proj=longlat +datum=WGS84")))
colnames(proj_lat.lon) <- c("x","y")
raster <- openmap(c(max(proj_lat.lon$y)+0.01, min(proj_lat.lon$x)-0.01),
c(min(proj_lat.lon$y)-0.01, max(proj_lat.lon$x)+0.01),
type = "bing")
raster_utm <- openproj(raster,
projection = "+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs")
no non-missing arguments to min; returning Infno non-missing arguments to max; returning -Infno non-missing arguments to min; returning Infno non-missing arguments to max; returning -Infno non-missing arguments to min; returning Infno non-missing arguments to max; returning -Inf
autoplot(raster_utm, expand = TRUE) + theme_bw() +
theme(legend.position="bottom") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_point(data=mink, aes(utm_easting,utm_northing,
color=factor(individual_local_identifier)), size = 3, alpha = 0.8) +
theme(axis.title = element_text(face="bold")) + labs(x="Easting",
y="Northing") + guides(color=guide_legend("Identifier"))

Minimum Convex Polygon
library(pbapply)
mcp_raster <- function(filename){
data <- read.csv(file = filename)
x <- as.data.frame(data$utm_easting)
y <- as.data.frame(data$utm_northing)
xy <- c(x,y)
data.proj <- SpatialPointsDataFrame(xy,data , proj4string = CRS("+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs"))
xy <- SpatialPoints(data.proj@coords)
mcp.out <- mcp(xy, percent=100, unout="ha")
mcp.points <- cbind((data.frame(xy)),data$individual_local_identifier)
colnames(mcp.points) <- c("x","y", "identifier")
mcp.poly <- fortify(mcp.out, region = "id")
units <- grid.text(paste(round(mcp.out@data$area,2),"ha"), x=0.85, y=0.95,
gp=gpar(fontface=4, col="white", cex=0.9), draw = FALSE)
mcp.plot <- autoplot(raster_utm, expand = TRUE) + theme_bw() + theme(legend.position="none") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_polygon(data=mcp.poly, aes(x=mcp.poly$long, y=mcp.poly$lat), alpha=0.8) +
geom_point(data=mcp.points, aes(x=x, y=y)) +
labs(x="Easting (m)", y="Northing (m)", title=mcp.points$identifier) +
theme(legend.position="none", plot.title = element_text(face = "bold", hjust = 0.5)) +
annotation_custom(units)
mcp.plot
}
pblapply(files, mcp_raster)
| | 0 % ~calculating
|============================ | 33% ~01s
|======================================================= | 67% ~00s
|==================================================================================| 100% elapsed=01s
[[1]]
[[2]]
[[3]]



Mink 11 had the largest home range and Mink 10 had the smallest
Kernel-Density Estimation
kde_raster <- function(filename){
data <- read.csv(file = filename)
x <- as.data.frame(data$utm_easting)
y <- as.data.frame(data$utm_northing)
xy <- c(x,y)
data.proj <- SpatialPointsDataFrame(xy,data, proj4string = CRS("+proj=utm +zone=16 +ellps=WGS84 +units=m +no_defs"))
xy <- SpatialPoints(data.proj@coords)
kde<-kernelUD(xy, h="href", kern="bivnorm", grid=100)
ver <- getverticeshr(kde, 95)
kde.points <- cbind((data.frame(data.proj@coords)),data$individual_local_identifier)
colnames(kde.points) <- c("x","y","identifier")
kde.poly <- fortify(ver, region = "id")
units <- grid.text(paste(round(ver$area,2)," ha"), x=0.85, y=0.95,
gp=gpar(fontface=4, col="white", cex=0.9), draw = FALSE)
kde.plot <- autoplot(raster_utm, expand = TRUE) + theme_bw() + theme(legend.position="none") +
theme(panel.border = element_rect(colour = "black", fill=NA, size=1)) +
geom_polygon(data=kde.poly, aes(x=kde.poly$long, y=kde.poly$lat), alpha = 0.8) +
geom_point(data=kde.points, aes(x=x, y=y)) +
labs(x="Easting (m)", y="Northing (m)", title=kde.points$identifier) +
theme(legend.position="none", plot.title = element_text(face = "bold", hjust = 0.5)) +
annotation_custom(units)
kde.plot
}
pblapply(files, kde_raster)
| | 0 % ~calculating
|============================ | 33% ~01s
|======================================================= | 67% ~00s
|==================================================================================| 100% elapsed=01s
[[1]]
[[2]]
[[3]]



LS0tDQp0aXRsZTogQW1lcmljYW4gbWluayAoTmVvdmlzb24gdmlzb24pIHNwYWNlIHVzZSBpbiBJbGxpbm9pcyAoZGF0YSBmcm9tIEFobGVycyBldCBhbC4gMjAxNSkNCmF1dGhvcjogIkx5cmFuZGEgVGhpZW0iDQpvdXRwdXQ6DQogIGh0bWxfZG9jdW1lbnQ6DQogICAgZGZfcHJpbnQ6IHBhZ2VkDQogICAgdG9jOiB5ZXMNCiAgaHRtbF9ub3RlYm9vazoNCiAgICBkZl9wcmludDogcGFnZWQNCiAgICBudW1iZXJfc2VjdGlvbnM6IG5vDQogICAgdGhlbWU6IGpvdXJuYWwgDQogICAgdG9jOiB5ZXMNCiAgICB0b2NfZmxvYXQ6DQogICAgICBjb2xsYXBzZWQ6IG5vDQogICAgICBzbW9vdGhfc2Nyb2xsOiB5ZXMNCiAgcGRmX2RvY3VtZW50OiBkZWZhdWx0DQplZGl0b3Jfb3B0aW9uczoNCiAgY2h1bmtfb3V0cHV0X3R5cGU6IGlubGluZQ0KLS0tDQoNCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9DQpwYWNrYWdlczwtYygiYWRlaGFiaXRhdEhSIiwiZGF0YS50YWJsZSIsImdnZm9ydGlmeSIsImdyaWQiLCJtb3ZlIiwibW92ZVZpcyIsIk9wZW5TdHJlZXRNYXAiLCJwYmFwcGx5IiwicGxvdGx5IiwicmdkYWwiLCJzcCIsInRpZHl2ZXJzZSIsInZpcmlkaXMiKQ0Kc2FwcGx5KHBhY2thZ2VzLCByZXF1aXJlLCBjaGFyYWN0ZXIub25seT1UKQ0KYGBgDQoNCiMjIyBBbWVyaWNhbiBNaW5rIERhdGFzZXQgDQoNClRoaXMgZGF0YXNldCBsb29rZWQgYXQgdGhlIEFtZXJpY2FuIE1pbmsgaG9tZSByYW5nZXMgaW4gSWxsaW5vaXMgd2hlcmUgdGhlcmUgaGFiaXRhdCBoYXMgYmVlbiBoaWdobHkgYWx0ZXJlZC5UaGV5IHN0dWRpZWQgMjAgaW5kaXZpZHVhbHMgZm9yIDYgeWVhcnMgKDIwMDctMjAxMikgYW5kIHJlY29yZGVkIHByZXNlbnQuIFRoZSB5ZWFycyBpbiB3aGljaCB0aGV5IHN0dWRpZWQgdGhlIG1pbmtzIHRoZXkgaGFkIHJlY29yZC1icmVha2luZyBkcm91Z2h0IGFuZCBmbG9vZCBjb25kaXRpb25zLiBUaGV5IHVzZWQgbWFyay1yZWNhcHR1cmUgbWV0aG9kcyBhbmQgdGVsZW1ldHJ5IHRvIHRyYWNrIHRoZSBpbmRpdmlkdWFscy4gDQoNCkZvciB0aGlzIGFzc2lnbm1lbnQgSSBsb29rZWQgYXQgaW5kaXZpZHVhbHMgMSAsIDEwIGFuZCAxMQ0KDQpJbmRpdmlkdWFsIDE6IDExNyBsb2NhdGlvbnMNCg0KSW5kaXZpZHVhbCAxMDogMTI1IGxvY2F0aW9ucyANCg0KSW5kaXZpZHVhbCAxMTogMTg0IGxvY2F0aW9ucyANCg0KDQoNCg0KDQpgYGB7ciBtZXNzYWdlPUZBTFNFLCB3YXJuaW5nPUZBTFNFfQ0KbWluayA8LSByZWFkX2NzdigibWluay5jc3YiKQ0KYGBgDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQpgYGB7cn0NCnFhcWNfcGxvdCA8LSBnZ3Bsb3QoKSArIGdlb21fcG9pbnQoZGF0YT1taW5rLCANCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgYWVzKHV0bV9lYXN0aW5nLHV0bV9ub3J0aGluZywNCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIGNvbG9yPWluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllcikpICsNCiAgICAgICAgICAgICAgICAgICAgICAgIGxhYnMoeD0iRWFzdGluZyIsIHk9Ik5vcnRoaW5nIikgKw0KICAgICAgICAgICAgICAgICAgICAgICAgZ3VpZGVzKGNvbG9yPWd1aWRlX2xlZ2VuZCgiSWRlbnRpZmllciIpKQ0KDQpnZ3Bsb3RseShxYXFjX3Bsb3QpDQpgYGANCg0KDQpgYGB7cn0NCmxhcHBseShzcGxpdChtaW5rLCBtaW5rJGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllciksIA0KICAgICAgIGZ1bmN0aW9uKHgpd3JpdGUuY3N2KHgsIGZpbGUgPSBwYXN0ZSh4JGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllclsxXSwiLmNzdiIpLCByb3cubmFtZXMgPSBGQUxTRSkpDQpgYGANCg0KDQpgYGB7cn0NCmZpbGVzIDwtIGMoIjEgLmNzdiIsIjEwIC5jc3YiLCAiMTEgLmNzdiIpDQpgYGANCg0KDQoNCg0KDQpgYGB7cn0NCnV0bV9wb2ludHMgPC0gY2JpbmQobWluayR1dG1fZWFzdGluZywgbWluayR1dG1fbm9ydGhpbmcpDQp1dG1fbG9jYXRpb25zIDwtIFNwYXRpYWxQb2ludHModXRtX3BvaW50cywgDQogICAgICAgICAgICAgICAgIHByb2o0c3RyaW5nPUNSUygiK3Byb2o9dXRtICt6b25lPTE2ICtkYXR1bT1XR1M4NCIpKQ0KcHJval9sYXQubG9uIDwtIGFzLmRhdGEuZnJhbWUoc3BUcmFuc2Zvcm0oDQogICAgICAgICAgICAgICAgdXRtX2xvY2F0aW9ucywgQ1JTKCIrcHJvaj1sb25nbGF0ICtkYXR1bT1XR1M4NCIpKSkNCmNvbG5hbWVzKHByb2pfbGF0LmxvbikgPC0gYygieCIsInkiKQ0KcmFzdGVyIDwtIG9wZW5tYXAoYyhtYXgocHJval9sYXQubG9uJHkpKzAuMDEsIG1pbihwcm9qX2xhdC5sb24keCktMC4wMSksIA0KICAgICAgICAgICAgICAgICAgYyhtaW4ocHJval9sYXQubG9uJHkpLTAuMDEsIG1heChwcm9qX2xhdC5sb24keCkrMC4wMSksIA0KICAgICAgICAgICAgICAgICAgdHlwZSA9ICJiaW5nIikNCnJhc3Rlcl91dG0gPC0gb3BlbnByb2oocmFzdGVyLCANCiAgICAgICAgICAgICAgcHJvamVjdGlvbiA9ICIrcHJvaj11dG0gK3pvbmU9MTYgK2VsbHBzPVdHUzg0ICt1bml0cz1tICtub19kZWZzIikNCmBgYA0KDQpgYGB7cn0NCmF1dG9wbG90KHJhc3Rlcl91dG0sIGV4cGFuZCA9IFRSVUUpICsgdGhlbWVfYncoKSArDQogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0iYm90dG9tIikgKw0KICB0aGVtZShwYW5lbC5ib3JkZXIgPSBlbGVtZW50X3JlY3QoY29sb3VyID0gImJsYWNrIiwgZmlsbD1OQSwgc2l6ZT0xKSkgKw0KICBnZW9tX3BvaW50KGRhdGE9bWluaywgYWVzKHV0bV9lYXN0aW5nLHV0bV9ub3J0aGluZywNCiAgICAgICAgICAgICBjb2xvcj1mYWN0b3IoaW5kaXZpZHVhbF9sb2NhbF9pZGVudGlmaWVyKSksIHNpemUgPSAzLCBhbHBoYSA9IDAuOCkgKw0KICB0aGVtZShheGlzLnRpdGxlID0gZWxlbWVudF90ZXh0KGZhY2U9ImJvbGQiKSkgKyBsYWJzKHg9IkVhc3RpbmciLA0KICAgICAgICB5PSJOb3J0aGluZyIpICsgZ3VpZGVzKGNvbG9yPWd1aWRlX2xlZ2VuZCgiSWRlbnRpZmllciIpKQ0KYGBgDQoNCiMjIyBNaW5pbXVtIENvbnZleCBQb2x5Z29uDQoNCmBgYHtyfQ0KbGlicmFyeShwYmFwcGx5KQ0KbWNwX3Jhc3RlciA8LSBmdW5jdGlvbihmaWxlbmFtZSl7DQogIGRhdGEgPC0gcmVhZC5jc3YoZmlsZSA9IGZpbGVuYW1lKQ0KICB4IDwtIGFzLmRhdGEuZnJhbWUoZGF0YSR1dG1fZWFzdGluZykNCiAgeSA8LSBhcy5kYXRhLmZyYW1lKGRhdGEkdXRtX25vcnRoaW5nKQ0KICB4eSA8LSBjKHgseSkNCiAgZGF0YS5wcm9qIDwtIFNwYXRpYWxQb2ludHNEYXRhRnJhbWUoeHksZGF0YSAsIHByb2o0c3RyaW5nID0gQ1JTKCIrcHJvaj11dG0gK3pvbmU9MTYgK2VsbHBzPVdHUzg0ICt1bml0cz1tICtub19kZWZzIikpDQogIHh5IDwtIFNwYXRpYWxQb2ludHMoZGF0YS5wcm9qQGNvb3JkcykNCiAgbWNwLm91dCA8LSBtY3AoeHksIHBlcmNlbnQ9MTAwLCB1bm91dD0iaGEiKQ0KICBtY3AucG9pbnRzIDwtIGNiaW5kKChkYXRhLmZyYW1lKHh5KSksZGF0YSRpbmRpdmlkdWFsX2xvY2FsX2lkZW50aWZpZXIpDQogIGNvbG5hbWVzKG1jcC5wb2ludHMpIDwtIGMoIngiLCJ5IiwgImlkZW50aWZpZXIiKQ0KICBtY3AucG9seSA8LSBmb3J0aWZ5KG1jcC5vdXQsIHJlZ2lvbiA9ICJpZCIpDQogIHVuaXRzIDwtIGdyaWQudGV4dChwYXN0ZShyb3VuZChtY3Aub3V0QGRhdGEkYXJlYSwyKSwiaGEiKSwgeD0wLjg1LCAgeT0wLjk1LA0KICAgICAgICAgICAgICAgICAgICAgZ3A9Z3Bhcihmb250ZmFjZT00LCBjb2w9IndoaXRlIiwgY2V4PTAuOSksIGRyYXcgPSBGQUxTRSkNCiAgbWNwLnBsb3QgPC0gYXV0b3Bsb3QocmFzdGVyX3V0bSwgZXhwYW5kID0gVFJVRSkgKyB0aGVtZV9idygpICsgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJub25lIikgKw0KICAgIHRoZW1lKHBhbmVsLmJvcmRlciA9IGVsZW1lbnRfcmVjdChjb2xvdXIgPSAiYmxhY2siLCBmaWxsPU5BLCBzaXplPTEpKSArDQogICAgZ2VvbV9wb2x5Z29uKGRhdGE9bWNwLnBvbHksIGFlcyh4PW1jcC5wb2x5JGxvbmcsIHk9bWNwLnBvbHkkbGF0KSwgYWxwaGE9MC44KSArDQogICAgZ2VvbV9wb2ludChkYXRhPW1jcC5wb2ludHMsIGFlcyh4PXgsIHk9eSkpICsgDQogICAgbGFicyh4PSJFYXN0aW5nIChtKSIsIHk9Ik5vcnRoaW5nIChtKSIsIHRpdGxlPW1jcC5wb2ludHMkaWRlbnRpZmllcikgKw0KICAgIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIsIHBsb3QudGl0bGUgPSBlbGVtZW50X3RleHQoZmFjZSA9ICJib2xkIiwgaGp1c3QgPSAwLjUpKSArIA0KICAgIGFubm90YXRpb25fY3VzdG9tKHVuaXRzKQ0KICBtY3AucGxvdA0KfQ0KDQpwYmxhcHBseShmaWxlcywgbWNwX3Jhc3RlcikNCmBgYA0KTWluayAxMSBoYWQgdGhlIGxhcmdlc3QgaG9tZSByYW5nZSBhbmQgTWluayAxMCBoYWQgdGhlIHNtYWxsZXN0IA0KDQoNCiMjIyBLZXJuZWwtRGVuc2l0eSBFc3RpbWF0aW9uDQoNCmBgYHtyfQ0Ka2RlX3Jhc3RlciA8LSBmdW5jdGlvbihmaWxlbmFtZSl7DQogIGRhdGEgPC0gcmVhZC5jc3YoZmlsZSA9IGZpbGVuYW1lKQ0KICB4IDwtIGFzLmRhdGEuZnJhbWUoZGF0YSR1dG1fZWFzdGluZykNCiAgeSA8LSBhcy5kYXRhLmZyYW1lKGRhdGEkdXRtX25vcnRoaW5nKQ0KICB4eSA8LSBjKHgseSkNCiAgZGF0YS5wcm9qIDwtIFNwYXRpYWxQb2ludHNEYXRhRnJhbWUoeHksZGF0YSwgcHJvajRzdHJpbmcgPSBDUlMoIitwcm9qPXV0bSArem9uZT0xNiArZWxscHM9V0dTODQgK3VuaXRzPW0gK25vX2RlZnMiKSkNCiAgeHkgPC0gU3BhdGlhbFBvaW50cyhkYXRhLnByb2pAY29vcmRzKQ0KICBrZGU8LWtlcm5lbFVEKHh5LCBoPSJocmVmIiwga2Vybj0iYml2bm9ybSIsIGdyaWQ9MTAwKQ0KICB2ZXIgPC0gZ2V0dmVydGljZXNocihrZGUsIDk1KQ0KICBrZGUucG9pbnRzIDwtIGNiaW5kKChkYXRhLmZyYW1lKGRhdGEucHJvakBjb29yZHMpKSxkYXRhJGluZGl2aWR1YWxfbG9jYWxfaWRlbnRpZmllcikNCiAgY29sbmFtZXMoa2RlLnBvaW50cykgPC0gYygieCIsInkiLCJpZGVudGlmaWVyIikNCiAga2RlLnBvbHkgPC0gZm9ydGlmeSh2ZXIsIHJlZ2lvbiA9ICJpZCIpDQogIHVuaXRzIDwtIGdyaWQudGV4dChwYXN0ZShyb3VuZCh2ZXIkYXJlYSwyKSwiIGhhIiksIHg9MC44NSwgIHk9MC45NSwNCiAgICAgICAgICAgICAgICAgICAgIGdwPWdwYXIoZm9udGZhY2U9NCwgY29sPSJ3aGl0ZSIsIGNleD0wLjkpLCBkcmF3ID0gRkFMU0UpDQogIGtkZS5wbG90IDwtIGF1dG9wbG90KHJhc3Rlcl91dG0sIGV4cGFuZCA9IFRSVUUpICsgdGhlbWVfYncoKSArIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpICsNCiAgICB0aGVtZShwYW5lbC5ib3JkZXIgPSBlbGVtZW50X3JlY3QoY29sb3VyID0gImJsYWNrIiwgZmlsbD1OQSwgc2l6ZT0xKSkgKw0KICAgIGdlb21fcG9seWdvbihkYXRhPWtkZS5wb2x5LCBhZXMoeD1rZGUucG9seSRsb25nLCB5PWtkZS5wb2x5JGxhdCksIGFscGhhID0gMC44KSArDQogICAgZ2VvbV9wb2ludChkYXRhPWtkZS5wb2ludHMsIGFlcyh4PXgsIHk9eSkpICsNCiAgICBsYWJzKHg9IkVhc3RpbmcgKG0pIiwgeT0iTm9ydGhpbmcgKG0pIiwgdGl0bGU9a2RlLnBvaW50cyRpZGVudGlmaWVyKSArDQogICAgdGhlbWUobGVnZW5kLnBvc2l0aW9uPSJub25lIiwgcGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChmYWNlID0gImJvbGQiLCBoanVzdCA9IDAuNSkpICsgDQogICAgYW5ub3RhdGlvbl9jdXN0b20odW5pdHMpDQogIGtkZS5wbG90DQp9DQoNCnBibGFwcGx5KGZpbGVzLCBrZGVfcmFzdGVyKQ0KYGBgDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQoNCg0KDQo=